home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gwuada_9.zip
/
MAINCASE.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-07-27
|
24KB
|
877 lines
/*
* Copyright (C) 1985-1992 New York University
*
* This file is part of the Ada/Ed-C system. See the Ada/Ed README file for
* warranty (none) and distribution info and also the GNU General Public
* License for more details.
*/
#define GEN
#include "hdr.h"
#include "vars.h"
#include "gvars.h"
#include "ops.h"
#include "segment.h"
#include "dbxp.h"
#include "namp.h"
#include "procp.h"
#include "exprp.h"
#include "setp.h"
#include "genp.h"
#include "statp.h"
#include "miscp.h"
#include "gmiscp.h"
#include "smiscp.h"
#include "segmentp.h"
#include "declp.h"
#include "typep.h"
#include "packp.h"
#include "gutilp.h"
#include "axqrp.h"
#include "sepp.h"
#include "maincasp.h"
static void compile_line();
void compile(Node node) /*;compile*/
{
/* Generates one TREE statement */
Node expr_node;
Symbol junk_var;
Tuple case_table;
Tuple tup;
Const cond_val;
Tuple labtup;
int lablev;
Node
pre_node, post_node, decl_node, id_list_node, type_node, init_node,
stmt_node, var_node, exp_node, if_list_node, else_node, cond_node,
body_node, cases_node, id_node, stmts_node, handler_node, proc_node,
args_node, obj_node, package_tasks_node,
entry_node, alt_node, acc_node, delay_node, call_node, stmts1_node,
stmts2_node, task_node, separate_unit_node, label_node, others_node,
n, temp_node;
Tuple condition_list, id_list, task_list, select_list, case_bodies;
Symbol label_name, type_name, proc_name, new_name, old_name, entry_name,
exception_name, package_tasks_name, else_part, dont_exit, end_if,
true_guard, end_alt, i_subt;
Tuple except_names, predef_tuple;
Tuple labs;
int nesting_depth, lineno, flag, tag, i;
int guarded;
/* DECL */
Fortup ft1;
int function_code;
Const ival;
int ikind;
Segment init_val;
#ifdef TRACE
if (debug_flag)
gen_trace_node("COMPILE", node);
#endif
#ifdef DEBUG
if (trapns>0 && N_SEQ(node) == trapns && N_UNIT(node) == trapnu)trapn(node);
#endif
switch(N_KIND(node)) {
case(as_opt): /* OPT_NODE */
break;
case(as_deleted): /* Deleted by expander */
break;
case(as_insert): /* Inserted by expander */
FORTUP(pre_node=(Node), N_LIST(node), ft1);
compile(pre_node);
ENDFORTUP(ft1);
post_node = N_AST1(node);
compile(post_node);
break;
case(as_discard): /* Some check to evaluate and discard */
expr_node = N_AST1(node);
junk_var = new_unique_name("junk"); /* TBSL: Reusing same variable */
next_local_reference(junk_var);
gen_ks(I_DECLARE, kind_of(N_TYPE(node)), junk_var);
gen_value(expr_node);
gen_ksc(I_POP, kind_of(N_TYPE(node)), junk_var, "Used only for check");
break;
/* Chapter 2. Lexical elements
*------------
* 2.8 Pragmas
*/
case(as_pragma): /*TBSL(JC) pragmas */
break;
case(as_arg): /*TBSL(JC) arguments for pragmas */
break;
/* Chapter 3. Declarations and types */
case(as_labels):
break;
/* 3.1 Declarations */
case(as_declarations):
FORTUP(decl_node=(Node), N_LIST(node), ft1);
compile(decl_node);
ENDFORTUP(ft1);
break;
/* 3.2 Objects and named numbers */
case(as_const_decl):
id_list_node = N_AST1(node);
type_node = N_AST2(node);
init_node = N_AST3(node);
/* Generate pre-statements */
while (N_KIND(init_node) == as_insert) {
FORTUP(pre_node=(Node), N_LIST(init_node), ft1);
compile(pre_node);
ENDFORTUP(ft1);
init_node = N_AST1(init_node);
}
id_list = N_LIST(id_list_node);
type_name = N_UNQ(type_node);
create_object(id_list, type_name, init_node, TRUE);
TASKS_DECLARED |= (int) CONTAINS_TASK(type_name);
break;
case(as_obj_decl):
id_list_node = N_AST1(node);
type_node = N_AST2(node);
init_node = N_AST3(node);
/* Generate pre-statements */
while (N_KIND(init_node) == as_insert) {
FORTUP(pre_node=(Node), N_LIST(init_node), ft1);
compile(pre_node);
ENDFORTUP(ft1);
init_node = N_AST1(init_node);
}
id_list = N_LIST(id_list_node);
type_name = N_UNQ(type_node);
create_object(id_list, type_name, init_node, FALSE);
TASKS_DECLARED |= (int)CONTAINS_TASK(type_name);
break;
case(as_num_decl):
break;
/* 3.3 Types and subtypes */
case(as_type_decl):
id_node = N_AST1(node);
type_name = N_UNQ(id_node);
gen_type(type_name);
break;
case(as_subtype_decl):
id_node = N_AST1(node);
type_name = N_UNQ(id_node);
gen_subtype(type_name);
break;
/* Chapter 5. Statements */
case(as_null_s):
break;
case(as_line_no):
NB_STATEMENTS += 1;
lineno = (int) N_VAL(node);
ada_line = lineno;
#ifdef MACHINE_CODE
if (debug_line > 0 && lineno >= debug_line)
compile_line();
#endif
if (line_option)
gen_i(I_STMT, lineno);
break;
/* 5.1 Simple and compound statements */
case(as_statements):
stmts_node = N_AST1(node);
label_node = N_AST2(node);
labs = tup_new(0);
FORTUP(n=(Node), N_LIST(label_node), ft1);
if (!tup_mem((char *) N_UNQ(n), labs))
labs =tup_with(labs, (char *)N_UNQ(n));
ENDFORTUP(ft1);
FORTUP(label_name=(Symbol), labs, ft1);
labelmap_put(label_name, LABEL_STATIC_DEPTH, (char *)CURRENT_LEVEL);
next_local_reference(label_name);
gen_s(I_SAVE_STACK_POINTER, label_name);
ENDFORTUP(ft1);
FORTUP(stmt_node=(Node), N_LIST(stmts_node), ft1);
compile(stmt_node);
ENDFORTUP(ft1);
tup_free(labs);
break;
case(as_statement):
label_node = N_AST1(node);
stmt_node = N_AST2(node);
labs = tup_new(0);
FORTUP(n=(Node), N_LIST(label_node), ft1);
if (!tup_mem((char *) N_UNQ(n), labs))
labs =tup_with(labs, (char *) N_UNQ(n));
ENDFORTUP(ft1);
FORTUP(label_name=(Symbol), labs, ft1);
gen_s(I_LABEL, label_name);
ENDFORTUP(ft1);
compile(stmt_node);
tup_free(labs);
break;
/* 5.2 Assignment statement */
case(as_assignment):
case(as_static_comp):
var_node = N_AST1(node);
exp_node = N_AST2(node);
type_name = get_type(var_node);
select_assign(var_node, exp_node, type_name);
break;
/* 5.3 If statement */
case(as_if):
if_list_node = N_AST1(node);
else_node = N_AST2(node);
end_if = new_unique_name("end_if");
condition_list = tup_copy(N_LIST(if_list_node));
/* tup_copy needed since condition_list used in tup_fromb below */
while (tup_size(condition_list)) {
n = (Node) tup_fromb(condition_list);
cond_node = N_AST1(n);
body_node = N_AST2(n);
else_part = new_unique_name("else");
gen_condition(cond_node, else_part, FALSE);
compile(body_node);
if ((tup_size(condition_list) != 0) || (else_node != OPT_NODE))
gen_s(I_JUMP, end_if);
gen_s(I_LABEL, else_part);
}
if (else_node != OPT_NODE)
compile(else_node);
gen_s(I_LABEL, end_if);
break;
/* 5.4 Case statements */
case(as_case):
exp_node = N_AST1(node);
cases_node = N_AST2(node);
gen_value(exp_node);
tup = make_case_table(cases_node);
case_table = (Tuple) tup[1];
case_bodies = (Tuple) tup[2];
others_node = (Node) tup[3];
gen_case(case_table, case_bodies, others_node,
kind_of(get_type(exp_node)));
break;
/* 5.5 Loop statements */
case(as_loop):
gen_loop(node);
break;
/* 5.6 Block statements */
case(as_block):
id_node = N_AST1(node);
decl_node = N_AST2(node);
stmts_node = N_AST3(node);
handler_node = N_AST4(node);
compile_body(decl_node, stmts_node, handler_node, TRUE);
break;
case(as_end):
gen(I_EXIT_BLOCK);
break;
/* 5.7 Exit statements */
case(as_exit):
cond_node = N_AST2(node);
label_name = N_UNQ(node);
if (cond_node != OPT_NODE) {
dont_exit = new_unique_name("continue");
gen_condition(cond_node, dont_exit, FALSE);
}
labtup = labelmap_get(label_name);
if (labtup == (Tuple)0)
chaos("as_exit label map undefined");
lablev = (int) labtup[LABEL_STATIC_DEPTH];
for (i = lablev;i<CURRENT_LEVEL; i++)
gen(I_EXIT_BLOCK);
gen_s(I_RESTORE_STACK_POINTER, label_name);
gen_s(I_JUMP, label_name);